home *** CD-ROM | disk | FTP | other *** search
/ MacFormat 1999 April / macformat-075.iso / Shareware Plus / Applications / Alpha / Tcl / Packages / recentFiles.tcl < prev    next >
Encoding:
Text File  |  1999-01-19  |  4.9 KB  |  153 lines  |  [TEXT/ALFA]
  1. ## -*-Tcl-*- (install)
  2.  # ###################################################################
  3.  #  Alpha - new Tcl folder configuration
  4.  # 
  5.  #  FILE: "recentFiles.tcl"
  6.  #                                    created: 21/9/97 {9:14:38 pm} 
  7.  #                                last update: 19/1/1999 {1:05:22 pm} 
  8.  #  
  9.  # Reorganisation carried out by Vince Darley with much help from Tom 
  10.  # Fetherston, Johan Linde and suggestions from the Alpha-D mailing list.  
  11.  # Alpha is shareware; please register with the author using the register 
  12.  # button in the about box.
  13.  #  
  14.  # original author probably Pete Keleher.  Vince added a bunch of
  15.  # code to work-around some Alpha-menu problems, and made it a 
  16.  # package.
  17.  # 
  18.  # Version 0.2 builds the menu about a zillion times faster than
  19.  # the original which built the menu once for every item at
  20.  # startup!  Also removed two unnecessary procs, since that stuff
  21.  # can be done elsewhere automatically.
  22.  # ###################################################################
  23.  ##
  24.  
  25. alpha::extension recentFilesMenu 0.2.7 {
  26.     namespace eval recent {}
  27.     ensureset recent::Files ""
  28.     hook::register saveasHook recent::push
  29.     hook::register openHook recent::push
  30.     menu::buildProc recent recent::makeMenu
  31.     menu::insert File submenu 2 recent
  32.     lappend modifiedVars recent::Files
  33.     # declare the fileset
  34.     set "gfileSetsType(Recent Files)" "procedural"
  35.     set "gfileSets(Recent Files)" recent::listFiles
  36.     lunion filesetsNotInMenu "Recent Files"
  37. } help {Adds a menu of recent files to the files menu, and a recent files fileset}
  38.  
  39. # The number of files to list in the 'Files->Recent' menu.
  40. newPref variable numberOfRecentFiles 15
  41.  
  42. ## 
  43.  # -------------------------------------------------------------------------
  44.  # 
  45.  # "recent::push" --
  46.  # 
  47.  #  Works with files whose name contained '[' or ']' which didn't before.
  48.  #  Doesn't add any file which fails 'file exists' to the menu.
  49.  # -------------------------------------------------------------------------
  50.  ##
  51. proc recent::push {name {name2 ""}} {
  52.     if {$name2 != ""} { set name $name2 }
  53.     global recent::Files numberOfRecentFiles file::separator
  54.     
  55.     regsub { <[0-9]+>$} $name {} name
  56.     if {![file exists $name]} { return }
  57.     if {[info tclversion] < 8.0} {
  58.     regsub -all {\\([][])} $name {\1} name
  59.     # this weird search handles a variety of unusual problems with
  60.     # Alpha's interpretation of menu items.
  61.     if {[info exists recent::Files] \
  62.       && ([set ind [lsearch -regexp ${recent::Files} "${file::separator}[quote::Regfind [file tail $name]]…?$"]] >= 0)} {
  63.         set recent::Files [lreplace ${recent::Files} $ind $ind]
  64.         lappend recent::Files $name
  65.         return
  66.     }
  67.     } else {
  68.     if {[info exists recent::Files] \
  69.       && ([set ind [lsearch -exact ${recent::Files} $name]] >= 0)} {
  70.         set recent::Files [lreplace ${recent::Files} $ind $ind]
  71.         lappend recent::Files $name
  72.         return
  73.     }
  74.     set ind 0
  75.     foreach f $recent::Files {
  76.         # perhaps we ought to test also for complications due to 
  77.         # files which end in '…'.
  78.         if {[file tail $f] == [file tail $name]} {
  79.         set recent::Files [lreplace ${recent::Files} $ind $ind]
  80.         lappend recent::Files $name
  81.         return
  82.         }
  83.         incr ind
  84.     }
  85.     }
  86.  
  87.     lappend recent::Files $name
  88.     if {[llength ${recent::Files}] > $numberOfRecentFiles} {
  89.     set recent::Files [lrange ${recent::Files} 1 end]
  90.     }
  91.     recent::makeMenu
  92. }
  93.  
  94. proc recent::makeMenu {} {
  95.     global recent::Files
  96.     set tails {}
  97.     foreach t ${recent::Files} {
  98.     lappend tails [file tail $t]
  99.     }
  100.     Menu -m -c -n recent -p recent::menuProc \
  101.       [concat [lsort -ignore $tails] [list "(-" "Reset List"]]
  102.     set enable [expr [llength ${recent::Files}] ? 1 : 0]
  103.     enableMenuItem File recent $enable
  104. }
  105.  
  106. ## 
  107.  # -------------------------------------------------------------------------
  108.  # 
  109.  # "recent::menuProc" --
  110.  # 
  111.  #  Works with menu items which contain '[', ']' and '…' which didn't work
  112.  #  before.
  113.  # -------------------------------------------------------------------------
  114.  ##
  115. proc recent::menuProc {menu name} {
  116.     global recent::Files file::separator
  117.     
  118.     if {$name == "Reset List"} {
  119.     set recent::Files {}
  120.     Menu -m -n recent -p recent::menuProc {}
  121.     recent::makeMenu
  122.     } else {
  123.     if {[set ind [lsearch -regexp ${recent::Files} "${file::separator}[quote::Regfind $name]…?$"]] >= 0} {
  124.         edit [lindex ${recent::Files} $ind]
  125.     } else {
  126.         # Sometime the above regexp search can have difficulties
  127.         # due to weird chars, or file-separator confusion.
  128.         foreach f ${recent::Files} {
  129.         if {[file tail $f] == $name} {
  130.             edit $f
  131.             return
  132.         }
  133.         }
  134.         alpha::errorAlert "Couldn't find a file '$name'.  Weird!"
  135.     }
  136.     }
  137. }
  138.  
  139. ## 
  140.  # -------------------------------------------------------------------------
  141.  # 
  142.  # "recent::listFiles" --
  143.  # 
  144.  #  Used to retrieve the list of files in the 'recent files' fileset
  145.  # -------------------------------------------------------------------------
  146.  ##
  147. proc recent::listFiles {} {
  148.     global recent::Files
  149.     return ${recent::Files}
  150. }
  151.  
  152.  
  153.